home *** CD-ROM | disk | FTP | other *** search
/ WINMX Assorted Textfiles / Ebooks.tar / Text - Tech - Programming - Visual Basic - Nod Programing VB Help Index 3 (TXT).zip / VBTips3.txt
Text File  |  1998-02-06  |  12KB  |  386 lines

  1.  
  2.             Nod Programing VB Help Index
  3. »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  4. This is intended for free use.  The code here is for various skill levels, 
  5. anyone from beginers to advanced programers can use these.  Do what you wish 
  6. with the code it is free for you to use and manipulate!
  7.  
  8. ****************************************************************************
  9.  
  10. Simple input validation:
  11.  
  12. Here's a way to achieve validation in text boxes and other controls that
  13. support the KeyPress event. It's simple, but functional.
  14.  
  15. First, add this function to your project:
  16.  
  17. Function ValiText(KeyIn As Integer, _ValidateString As String, _Editable
  18.  As Boolean) As Integer
  19.   
  20.     Dim ValidateList As String
  21.     Dim KeyOut As Integer
  22.     '
  23.     If Editable = True Then
  24.          ValidateList = UCase(ValidateString) & Chr(8)
  25.     Else
  26.          ValidateList = UCase(ValidateString)
  27.     End If
  28.     '
  29.     If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
  30.         KeyOut = KeyIn
  31.     Else
  32.         KeyOut = 0
  33.         Beep
  34.     End If
  35.     '
  36.     ValiText = KeyOut
  37.     '
  38. End Function
  39.  
  40. Then, for each control whose input you wish to validate, just put something
  41. like this in the KeyPress event of the control:
  42.  
  43. KeyAscii=ValiText(Keyascii, "0123456789/-",True)
  44.  
  45. Doing so will filter out any undesired keys that go to the control,
  46. accepting only the keys defined by the second parameter. In this case, that
  47. parameter ("0123456789/-") defines characters that are valid for a date.
  48.  
  49. The function's third parameter controls whether the [Backspace] key can be
  50. used.
  51.  
  52. Note that this implementation of the function ignores the case of the
  53. incoming keys, so if your second parameter were "abcdefg", the function
  54. would also allow "ABCDEFG" to be entered.
  55.  
  56. ****************************************************************************
  57.  
  58. Simplying the addition of items to ComboBoxes:
  59.  
  60. I often need to add items to a ComboBox and store an index or ID value in
  61. the ItemData property. I've found that the code needed to add items to the
  62. ComboBox and to check the ItemData property of the currently selected item
  63. looks clumsy. So, I've written two simple helper routines to clean the code
  64. up a bit. Here they are:
  65.  
  66. '---------------------------------------------------------------------------
  67.  
  68.  '   AddComboItem
  69.  '   AddComboItem
  70.  
  71. '---------------------------------------------------------------------------
  72.  Public Sub AddComboItem( _cboAdd As ComboBox, _ByVal sText As String, 
  73.  _ByVal lData As Long)
  74.  
  75.      cboAdd.AddItem sText
  76.      cboAdd.ItemData(cboAdd.NewIndex)  lData
  77.    
  78.  End Sub
  79.  
  80. '---------------------------------------------------------------------------
  81.  '   CurrComboData
  82.  '   CurrComboData
  83.  
  84. '---------------------------------------------------------------------------
  85.  Public Function CurrComboData( _cbo As ComboBox) As Long
  86.  
  87.     If cbo.ListIndex <> -1 Then
  88.        CurrComboData = cbo.ItemData(cbo.ListIndex)
  89.     Else
  90.        CurrComboData = -1
  91.     End If
  92.  
  93.  End Function
  94.  
  95. Now, instead of writing
  96.  
  97.  cboTest.AddItem "Hello"
  98.  cboTest.ItemData(cboTest.NewIndex) = 5
  99.  
  100. you can just write
  101.  
  102.  AddComboItem cboTest, "Hello",5
  103.  
  104. Instead of writing
  105.  
  106.  ID = cboTest.ItemData(cboTest.ListIndex)
  107.  
  108. you can write
  109.  
  110.  ID = CurrComboData( cboTest )
  111.  
  112. As an added bonus, CurrComboData protects you from the runtime error
  113. generated if ListIndex is -1. Just be sure to check for a return of -1 from
  114. CurrComboData.
  115.  
  116. ****************************************************************************
  117.  
  118. Showing long ListBox entries as a ToolTip:
  119.  
  120. Sometimes the data you want to display in a list is too long for the size
  121. of ListBox you can use. When this happens, you can use some simple code to
  122. display the ListBox entries as ToolTips when the mouse passes over the
  123. ListBox.
  124.  
  125. First, start a new VB project and add a ListBox to the default form. Then
  126. declare the SendMessage API call and the constant (LB_ITEMFROMPOINT) needed
  127. for the operation:
  128.  
  129. Option Explicit
  130.  
  131. 'Declare the API function call.
  132. Private Declare Function SendMessage _
  133.   Lib "user32" Alias "SendMessageA" _
  134.   (ByVal hwnd As Long, _
  135.     ByVal wMsg As Long, _
  136.     ByVal wParam As Long, _
  137.     lParam As Any) As Long
  138. ' Add API constant
  139. Private Const LB_ITEMFROMPOINT = &H1A9
  140.  
  141. Next, add some code to the form load event to fill the ListBox with data:
  142.  
  143. Private Sub Form_Load()
  144.     '
  145.     ' load some items in the list box
  146.     With List1
  147.         .AddItem "Michael Clifford Amundsen"
  148.         .AddItem "Walter P.K. Smithworthy, III"
  149.         .AddItem "Alicia May Sue McPherson-Pennington"
  150.     End With
  151.     '
  152. End Sub
  153.  
  154. Finally, in the MouseMove event of the ListBox, put the following code:
  155.  
  156. Private Sub List1_MouseMove(Button As Integer, Shift As Integer, _
  157. X As Single, Y As Single)
  158.     '
  159.     ' present related tip message
  160.     '
  161.     Dim lXPoint As Long
  162.     Dim lYPoint As Long
  163.     Dim lIndex As Long
  164.     '
  165.     If Button = 0 Then ' if no button was pressed
  166.         lXPoint = CLng(X / Screen.TwipsPerPixelX)
  167.         lYPoint = CLng(Y / Screen.TwipsPerPixelY)
  168.         '
  169.         With List1
  170.             ' get selected item from list
  171.             lIndex = SendMessage(.hwnd, _
  172.               LB_ITEMFROMPOINT, _
  173.               0, _
  174.               ByVal ((lYPoint * 65536) + lXPoint))
  175.             ' show tip or clear last one
  176.             If (lIndex >= 0) And (lIndex <= .ListCount) Then
  177.                 .ToolTipText = .List(lIndex)
  178.             Else
  179.                 .ToolTipText = ""
  180.             End If
  181.         End With '(List1)
  182.     End If '(button=0)
  183.     '
  184. End Sub
  185.  
  186. ****************************************************************************
  187.  
  188. Creating Short Arrays Using the Variant Data Type:
  189.  
  190. If you need to create a short list of items in an array, you can save a lot
  191. of coding by using the Variant data type instead of a dimensioned standard
  192. data type. This is especially handy when you need to create a list of short
  193. phrases to support numeric output.
  194.  
  195. For example, add a button to a standard VB form and paste the following
  196. code into the Click event of the button:
  197.  
  198. Private Sub Command1_Click()
  199.     '
  200.     ' create a quick array using variants
  201.     '
  202.     Dim aryList As Variant
  203.     '
  204.     aryList = Array("No Access", "Read-Only", "Update", "Delete")
  205.     '
  206.     MsgBox aryList(2)
  207.     '
  208. End Sub
  209.  
  210. ****************************************************************************
  211.  
  212. Using GetRows to Quickly Save Data Fields to Memory Variables:
  213.  
  214. If you need to copy information from database fields into memory variables,
  215. you can do it quickly using the GetRows method of the Recordset object. The
  216. GetRows method copies one or more rows of data directly into a Variant data
  217. type and stores the information as a two-dimensional array in the
  218. formvarData(Field,Column).
  219.  
  220. To test the GetRow method, add a button to a VB form and paste the
  221. following code into the Click event of the button.  Be sure to fix the
  222. reference to location of the BIBLIO.MDB database in the OpenDatabase
  223. method. Also be sure to set up a reference to the Microsoft DAO 3.5 Object
  224. Library.
  225.  
  226. Private Sub cmdGetDataRow_Click()
  227.     '
  228.     ' show getrow method
  229.     '
  230.     Dim ws As Workspace
  231.     Dim db As Database
  232.     Dim rs As Recordset
  233.     '
  234.     Dim varDataRows As Variant
  235.     Dim intRows As Integer
  236.     Dim intColumns As Integer
  237.     '
  238.     Dim intLoopRow As Integer
  239.     Dim intLoopCol As Integer
  240.     Dim strMsg As String
  241.     '
  242.     Set ws = DBEngine.CreateWorkspace(App.EXEName, "admin", "")
  243.     Set db = ws.OpenDatabase("e:\devstudio\vb\biblio.mdb")
  244.     Set rs = db.OpenRecordset("SELECT * FROM Authors")
  245.     '
  246.     intRows = InputBox("How Many Rows?", "GetRows Example", 0)
  247.     intColumns = rs.Fields.Count
  248.     varDataRows = rs.GetRows(intRows)
  249.     '
  250.     For intLoopRow = 0 To intRows - 1
  251.         strMsg = ""
  252.         For intLoopCol = 0 To intColumns - 1
  253.             strMsg = strMsg & varDataRows(intLoopCol, intLoopRow) & vbCrLf
  254.         Next
  255.         MsgBox strMsg
  256.     Next
  257.     '
  258.     rs.Close
  259.     db.Close
  260.     ws.Close
  261.     '
  262. End Sub
  263.  
  264. ****************************************************************************
  265.  
  266. Getting sensible Win32 API call errors:
  267.  
  268. Most of the Win32 API calls return extended error information when they
  269. fail. To get this information in a sensible format, you can use the
  270. GetLastError and FormatMessage APIs.
  271.  
  272. Add the following declarations and function to a BAS module in a VB project:
  273.  
  274. Option Explicit
  275.  
  276. Public Declare Function GetLastError _
  277.   Lib "kernel32" () As Long
  278. Public Declare Function FormatMessage _
  279.   Lib "kernel32" Alias "FormatMessageA" _
  280.  (ByVal dwFlags As Long, _
  281.   lpSource As Any, _
  282.   ByVal dwMessageId As Long, _
  283.   ByVal dwLanguageId As Long, _
  284.   ByVal lpBuffer As String, _
  285.   ByVal nSize As Long, _
  286.   Arguments As Long) As Long
  287.  
  288. Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
  289.  
  290. Public Function LastSystemError() As String
  291.     '
  292.     ' better system error
  293.     '
  294.     Dim sError As String * 500
  295.     Dim lErrNum As Long
  296.     Dim lErrMsg As Long
  297.     '
  298.     lErrNum = GetLastError
  299.     lErrMsg = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
  300.       ByVal 0&, lErrNum, 0, sError, Len(sError), 0)
  301.     LastSystemError = Trim(sError)
  302.     '
  303. End Function
  304.  
  305. Now place a command button on a standard VB form and call the
  306. LastSystemError function:
  307.  
  308. Private Sub Command1_Click()
  309.     '
  310.     MsgBox LastSystemError
  311.     '
  312. End Sub
  313.  
  314. If there was no error registered, you'll see a message saying "The
  315. operation completed successfully."
  316.  
  317. When using this function, keep these points in mind:
  318.  
  319. 1. Many API calls reset the value of GetLastError when successful, so the
  320. function must be called immediately after the API call that failed.
  321.  
  322. 2. The last error value is kept on a per-thread basis, therefore the
  323. function must be called from the same thread as the API call that failed.
  324.  
  325. ****************************************************************************
  326.  
  327. Increment and decrement dates with the [+] and [-] keys:
  328.  
  329. If you've ever used Quicken, you've probably notice a handy little feature
  330. in that program's date fields. You can press the [+] key to increment one
  331. day, [-] to decrement one day, [PgUp] to increment one month, and [PgDn] to
  332. decrement one month. In this tip, we'll show you how to emulate this
  333. behavior with Visual Basic.
  334.  
  335. First, insert a text box on a form (txtDate). Set its text property to ""
  336. and its Locked property to TRUE.
  337.  
  338. Now place the following code in the KeyDown event:
  339.  
  340. Private Sub txtDate_KeyDown(KeyCode As Integer, Shift As Integer)
  341.     '
  342.     ' 107 = "+" KeyPad
  343.     ' 109 = "-" KeyPad
  344.     ' 187 = "+" (Actually this is the "=" key, same as "+" w/o the=
  345.  shift)
  346.     ' 189 = "-"
  347.     ' 33 = PgUp
  348.     ' 34 = PgDn
  349.     '
  350.     Dim strYear As String
  351.     Dim strMonth As String
  352.     Dim strDay As String
  353.     '
  354.     If txtDate.Text = "" Then
  355.         txtDate.Text = Format(Now, "m/d/yyyy")
  356.         Exit Sub
  357.     End If
  358.     '
  359.     strYear = Format(txtDate.Text, "yyyy")
  360.     strMonth = Format(txtDate.Text, "mm")
  361.     strDay = Format(txtDate.Text, "dd")
  362.     '
  363.     Select Case KeyCode
  364.         Case 107, 187 ' add a day
  365.             txtDate.Text = Format(DateSerial(strYear, strMonth, strDay) +
  366. 1, "m/d/yyyy")
  367.         Case 109, 189 ' subtract a day
  368.             txtDate.Text = Format(DateSerial(strYear, strMonth, strDay) -
  369. 1, "m/d/yyyy")
  370.         Case 33 ' add a month
  371.             txtDate.Text = Format(DateSerial(strYear, strMonth + 1,
  372. strDay), "m/d/yyyy")
  373.         Case 34 ' subtract a month
  374.             txtDate.Text = Format(DateSerial(strYear, strMonth - 1,
  375. strDay), "m/d/yyyy")
  376.     End Select
  377.     '
  378. End Sub
  379.  
  380. The one nasty thing about this is that if you have characters that are not
  381. the characters usually in a date (i.e., 1-9, Monday, Tuesday, or /) you get
  382. errors in the format command. To overcome this, I set the Locked property
  383. to True. This way, the user can't actually type a character in the field,
  384. but the KeyDown event still fires.
  385.  
  386.             End of Help 3 of how many I do!!